home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / expand.t < prev    next >
Text File  |  1988-05-02  |  5KB  |  120 lines
  1. (herald (front_end expand))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;;              Macro expansion of top level forms.
  27. ;;;============================================================================
  28. ;;;   EXPAND-FORMS expands all of the EXPS that are macros.  A list of
  29. ;;; (<expression> <syntax-table>) lists is returned where <expression> is not
  30. ;;; a macro and <syntax-table> contains the syntax that is to be used in
  31. ;;; compiling <expression>.
  32. ;;;
  33. ;;;   EXPAND-FORMS deals with macros and the special-forms DEFINE-LOCAL-SYNTAX,
  34. ;;; LET-SYNTAX, and BLOCK.
  35.  
  36. (define (expand-forms exps syntax)
  37.   (reverse! (real-expand-forms exps syntax)))
  38.  
  39. ;;; Loop down the list EXPS calling EXPAND on each expression in turn.  If the
  40. ;;; expression expands in to (BLOCK . <exps>) then the <exps> are expanded
  41. ;;; by a recursive call.
  42.  
  43. (define (real-expand-forms exps syntax)
  44.   (iterate loop ((exps exps) (syntax syntax) (res '()))
  45.     (cond ((null? exps)
  46.            res)
  47.           (else
  48.            (receive (exp local-syntax new-syntax)
  49.                     (expand (car exps) syntax)
  50.              (cond ((and (pair? exp)
  51.                          (eq? (car exp) syntax/block))
  52.                     (loop (cdr exps)
  53.                           new-syntax
  54.                           (append! (real-expand-forms (cdr exp) local-syntax)
  55.                                    res)))
  56.                    (else
  57.                     (loop (cdr exps)
  58.                           new-syntax
  59.                           `((,exp ,local-syntax) . ,res)))))))))
  60.  
  61. ;;; Expand EXP using syntax table SYNTAX.  Just checks to see if it is a macro.
  62.  
  63. (define (expand exp syntax)
  64.   (cond ((atom? exp)
  65.          (values exp syntax syntax))
  66.         ((symbol? (car exp))
  67.          (let ((probe (syntax-table-entry syntax (car exp))))
  68.            (cond ((null? probe)
  69.                   (values exp syntax syntax))
  70.                  (else
  71.                   (expand-special-form probe exp syntax)))))
  72.         ((syntax-descriptor? (car exp))
  73.          (expand-special-form (car exp) exp syntax))
  74.         (else
  75.          (values exp syntax syntax))))
  76.  
  77. ;;; Does syntax error checking, primitive syntax dispatch, and macro 
  78. ;;; expansion.  The error checking is done by CHECK-SPECIAL-FORM, a T system
  79. ;;; procedure.
  80.  
  81. (define (expand-special-form descr exp syntax)
  82.   (let ((proc (table-entry primitive-handler-table descr))
  83.         (new-exp (check-special-form-syntax descr exp)))
  84.     (cond ((neq? exp new-exp)
  85.            ;; An error was reported, and luser gave us a new form.
  86.            (expand new-exp syntax))
  87.           ((eq? descr syntax/let-syntax)
  88.            (expand-let-syntax exp syntax))
  89.           ((eq? descr syntax/define-local-syntax)
  90.            (expand-local-syntax exp syntax))
  91.           (proc
  92.            (values (cons descr (cdr exp)) syntax syntax))
  93.           ((macro-expander? descr)
  94.            (expand (expand-macro-form descr exp syntax) syntax))
  95.           (else
  96.            (syntax-error '"special form unknown to this compiler~%  ~S" exp)))))
  97.  
  98. ;;; DEFINE-LOCAL-SYNTAX
  99. ;;;  Returns an updated syntax table to be used in expanding the expressions
  100. ;;; that follow.
  101.  
  102. (define (expand-local-syntax exp syntax)
  103.   (let ((new-syntax (make-syntax-table syntax nil)))
  104.     (set-local-syntax new-syntax (cdr exp))
  105.     (values `(,syntax/block) new-syntax new-syntax)))
  106.  
  107. ;;; LET-SYNTAX
  108. ;;;  Returns an updated syntax table to be used in expanding the expressions
  109. ;;; in the body and the old syntax table for expanding the ones that follow.
  110.  
  111. (define (expand-let-syntax exp syntax)
  112.   (destructure (((#f specs . body) exp))
  113.     (let ((new-syntax (make-syntax-table syntax nil)))
  114.       (walk (lambda (spec)
  115.               (set-local-syntax new-syntax spec))
  116.             specs)
  117.       (values `(,syntax/block . ,body) new-syntax syntax))))
  118.  
  119.  
  120.